home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 2: Applications / Linux Cubed Series 2 - Applications.iso / editors / emacs / xemacs / xemacs-1.004 / xemacs-1 / xemacs-19.13 / src / callint.c < prev    next >
Encoding:
C/C++ Source or Header  |  1995-08-04  |  25.6 KB  |  840 lines
  1. /* Call a Lisp function interactively.
  2.    Copyright (C) 1985, 1986, 1992, 1993, 1994 Free Software Foundation, Inc.
  3.  
  4. This file is part of XEmacs.
  5.  
  6. XEmacs is free software; you can redistribute it and/or modify it
  7. under the terms of the GNU General Public License as published by the
  8. Free Software Foundation; either version 2, or (at your option) any
  9. later version.
  10.  
  11. XEmacs is distributed in the hope that it will be useful, but WITHOUT
  12. ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
  13. FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
  14. for more details.
  15.  
  16. You should have received a copy of the GNU General Public License
  17. along with XEmacs; see the file COPYING.  If not, write to the Free
  18. Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.  */
  19.  
  20. /* Synched up with: Mule 2.0.  Not synched with FSF. */
  21.  
  22. #include <config.h>
  23. #include "lisp.h"
  24. #include "buffer.h"
  25. #include "bytecode.h"
  26. #include "commands.h"
  27. #include "window.h"
  28. #include "emacsfns.h"
  29. #include "insdel.h"
  30.  
  31. extern int num_input_chars;
  32.  
  33. Lisp_Object Vprefix_arg, Vcurrent_prefix_arg;
  34. Lisp_Object Qcall_interactively;
  35. Lisp_Object Vcommand_history;
  36.  
  37. Lisp_Object Vcommand_debug_status, Qcommand_debug_status;
  38. Lisp_Object Qenable_recursive_minibuffers;
  39.  
  40. Lisp_Object Qcurrent_prefix_arg;
  41.  
  42. Lisp_Object Quser_variable_p;
  43. Lisp_Object Qread_from_minibuffer;
  44. Lisp_Object Qread_file_name;
  45. Lisp_Object Qread_directory_name;
  46. Lisp_Object Qcompleting_read;
  47. Lisp_Object Qread_buffer;
  48. Lisp_Object Qread_function;
  49. Lisp_Object Qread_variable;
  50. Lisp_Object Qread_expression;
  51. Lisp_Object Qread_command;
  52. Lisp_Object Qread_number;
  53. Lisp_Object Qread_string;
  54. Lisp_Object Qevents_to_keys;
  55.  
  56. #ifdef MULE
  57. Lisp_Object Qread_coding_system;
  58. Lisp_Object Qread_non_nil_coding_system;
  59. #endif
  60.  
  61. /* ARGSUSED */
  62. DEFUN ("interactive", Finteractive, Sinteractive, 0, UNEVALLED, 0,
  63.  "Specify a way of parsing arguments for interactive use of a function.\n\
  64. For example, write\n\
  65.   (defun foo (arg) \"Doc string\" (interactive \"p\") ...use arg...)\n\
  66. to make ARG be the prefix argument when `foo' is called as a command.\n\
  67. The \"call\" to `interactive' is actually a declaration rather than a function;\n\
  68.  it tells `call-interactively' how to read arguments\n\
  69.  to pass to the function.\n\
  70. When actually called, `interactive' just returns nil.\n\
  71. \n\
  72. The argument of `interactive' is usually a string containing a code letter\n\
  73.  followed by a prompt.  (Some code letters do not use I/O to get\n\
  74.  the argument and do not need prompts.)  To prompt for multiple arguments,\n\
  75.  give a code letter, its prompt, a newline, and another code letter, etc.\n\
  76.  Prompts are passed to format, and may use % escapes to print the\n\
  77.  arguments that have already been read.\n\
  78. If the argument is not a string, it is evaluated to get a list of\n\
  79.  arguments to pass to the function.\n\
  80. Just `(interactive)' means pass no args when calling interactively.\n\
  81. \nCode letters available are:\n\
  82. a -- Function name: symbol with a function definition.\n\
  83. b -- Name of existing buffer.\n\
  84. B -- Name of buffer, possibly nonexistent.\n\
  85. c -- Character.\n\
  86. C -- Command name: symbol with interactive function definition.\n\
  87. d -- Value of point as number.  Does not do I/O.\n\
  88. D -- Directory name.\n\
  89. e -- Last mouse event.  Does not do I/O.\n\
  90. f -- Existing file name.\n\
  91. F -- Possibly nonexistent file name.\n\
  92. i -- Always nil.  Does not do I/O.\n\
  93. k -- Key sequence (a vector of events).\n\
  94. m -- Value of mark as number.  Does not do I/O.\n\
  95. n -- Number read using minibuffer.\n\
  96. N -- Prefix arg converted to number, or if none, do like code `n'.\n\
  97. p -- Prefix arg converted to number.  Does not do I/O.\n\
  98. P -- Prefix arg in raw form.  Does not do I/O.\n\
  99. r -- Region: point and mark as 2 numeric args, smallest first.  Does no I/O.\n\
  100. s -- Any string.\n\
  101. S -- Any symbol.\n\
  102. v -- Variable name: symbol that is user-variable-p.\n\
  103. x -- Lisp expression read but not evaluated.\n\
  104. X -- Lisp expression read and evaluated.\n\
  105. z -- Coding system.\n\
  106. Z -- Coding system, nil if no prefix arg.\n\
  107. In addition, if the string begins with `*'\n\
  108.  then an error is signaled if the buffer is read-only.\n\
  109.  This happens before reading any arguments.\n\
  110. If the string begins with `@', then the window the mouse is over is selected\n\
  111.  before anything else is done.\n\
  112. If the string begins with `_', then this command will not cause the region\n\
  113.  to be deactivated when it completes; that is, `zmacs-region-stays' will be\n\
  114.  set to t when the command exits successfully.\n\
  115. You may use any of `@', `*' and `_' at the beginning of the string;\n\
  116.  they are processed in the order that they appear.")
  117.   (args)
  118.      Lisp_Object args;
  119. {
  120.   return Qnil;
  121. }
  122.  
  123. /* Quotify EXP: if EXP is constant, return it.
  124.    If EXP is not constant, return (quote EXP).  */
  125. static Lisp_Object
  126. quotify_arg (Lisp_Object exp)
  127. {
  128.   if (!INTP (exp) && !STRINGP (exp)
  129.       && !NILP (exp) && !EQ (exp, Qt))
  130.     return Fcons (Qquote, Fcons (exp, Qnil));
  131.  
  132.   return exp;
  133. }
  134.  
  135. /* Modify EXP by quotifying each element (except the first).  */
  136. static Lisp_Object
  137. quotify_args (Lisp_Object exp)
  138. {
  139.   REGISTER Lisp_Object tail;
  140.   REGISTER struct Lisp_Cons *ptr;
  141.   for (tail = exp; CONSP (tail); tail = ptr->cdr)
  142.     {
  143.       ptr = XCONS (tail);
  144.       ptr->car = quotify_arg (ptr->car);
  145.     }
  146.   return exp;
  147. }
  148.  
  149. static Bufpos
  150. check_mark (void)
  151. {
  152.   Lisp_Object tem;
  153.  
  154.   if (zmacs_regions && !zmacs_region_active_p)
  155.     error ("The region is not active now");
  156.  
  157.   tem = Fmarker_buffer (current_buffer->mark);
  158.   if (NILP (tem) || (XBUFFER (tem) != current_buffer))
  159.     error ("The mark is not set now");
  160.  
  161.   return (marker_position (current_buffer->mark));
  162. }
  163.  
  164. Lisp_Object Vcurrent_mouse_event;
  165.  
  166. static Lisp_Object
  167. callint_prompt (CONST Bufbyte *prompt_start, Bytecount prompt_length,
  168.                 CONST Lisp_Object *args, int nargs)
  169. {
  170.   Lisp_Object s = make_string (prompt_start, prompt_length);
  171.   struct gcpro gcpro1;
  172.  
  173.   /* Fformat no longer smashes its arg vector, so no need to copy it. */
  174.   
  175.   if (!strchr ((char *) string_data (XSTRING (s)), '%'))
  176.     return (s);
  177.   GCPRO1 (s);
  178.   RETURN_UNGCPRO (emacs_doprnt_string_lisp (0, s, 0, nargs, args));
  179. }
  180.  
  181. DEFUN ("call-interactively", Fcall_interactively, Scall_interactively, 1, 2, 0,
  182.   "Call FUNCTION, reading args according to its interactive calling specs.\n\
  183. The function contains a specification of how to do the argument reading.\n\
  184. In the case of user-defined functions, this is specified by placing a call\n\
  185. to the function `interactive' at the top level of the function body.\n\
  186. See `interactive'.\n\
  187. \n\
  188. If optional second arg RECORD-FLAG is the symbol `lambda', the interactive\n\
  189. calling arguments for FUNCTION are read and returned as a list,\n\
  190. but the function is not called on them.\n\
  191. \n\
  192. If RECORD-FLAG is `t' then unconditionally put this command in the\n\
  193. command-history.  Otherwise, this is done only if an arg is read using\n\
  194. the minibuffer.")
  195.   (function, record_flag)
  196.      Lisp_Object function, record_flag;
  197. {
  198.   /* This function can GC */
  199.   int speccount = specpdl_depth ();
  200.   /* Save this now, since use of minibuffer will clobber it. */
  201.   Lisp_Object prefix = Vcurrent_prefix_arg;
  202.  
  203.   Lisp_Object fun;
  204.   Lisp_Object specs = Qnil;
  205.   /* If SPECS is a string, we reset prompt_data to string_data (XSTRING (specs))
  206.    *  every time a GC might have occurred */
  207.   CONST char *prompt_data = 0;
  208.   int prompt_index = 0;
  209.   int argcount;
  210.   int set_zmacs_region_stays = 0;
  211.  
  212.  retry:
  213.  
  214.   fun = indirect_function (function, 1);
  215.  
  216.   /* Decode the kind of function.  Either handle it and return,
  217.      or go to `lose' if not interactive, or go to `retry'
  218.      to specify a different function, or set either PROMPT_DATA or SPECS. */
  219.  
  220.   if (SUBRP (fun))
  221.     {
  222.       prompt_data = XSUBR (fun)->prompt;
  223.       if (!prompt_data)
  224.     {
  225.     lose:
  226.       function = wrong_type_argument (Qcommandp, function);
  227.       goto retry;
  228.     }
  229.     }
  230.   else if (BYTECODEP (fun))
  231.     {
  232.       struct Lisp_Bytecode *b = XBYTECODE (fun);
  233.       if (!(b->flags.interactivep))
  234.         goto lose;
  235.       specs = bytecode_interactive (b);
  236.     }
  237.   else if (!CONSP (fun))
  238.     goto lose;
  239.   else
  240.     {
  241.       Lisp_Object funcar = Fcar (fun);
  242.  
  243.       if (EQ (funcar, Qautoload))
  244.     {
  245.       struct gcpro gcpro1, gcpro2;
  246.       GCPRO2 (function, prefix);
  247.       do_autoload (fun, function);
  248.       UNGCPRO;
  249.       goto retry;
  250.     }
  251.       else if (EQ (funcar, Qlambda))
  252.     {
  253.       specs = Fassq (Qinteractive, Fcdr (Fcdr (fun)));
  254.       if (NILP (specs))
  255.         goto lose;
  256.       specs = Fcar (Fcdr (specs));
  257.     }
  258. #ifdef MOCKLISP_SUPPORT
  259.       else if (EQ (funcar, Qmocklisp))
  260.     return ml_apply (fun, Qinteractive);
  261. #endif
  262.       else
  263.     goto lose;
  264.     }
  265.  
  266.   /* If either specs or prompt_data is set to a string, use it.  */
  267.   if (!STRINGP (specs) && prompt_data == 0)
  268.     {
  269.       struct gcpro gcpro1, gcpro2;
  270.       int i = num_input_chars;
  271.       GCPRO2 (function, specs);
  272.       specs = Feval (specs);
  273.       if (EQ (record_flag, Qlambda))
  274.     {
  275.       UNGCPRO;
  276.       return (specs);
  277.     }
  278.       if (!NILP (record_flag) || i != num_input_chars)
  279.     {
  280.       /* #### There's no way for an interactive spec to put something
  281.        *  other than its literal arguments on the command-history.
  282.        *  For example, it should be possible to put (region-beginning)
  283.        *  on instead of some random point position like 259.
  284.        */
  285.       Vcommand_history
  286.         = Fcons (Fcons (function, quotify_args (Fcopy_sequence (specs))),
  287.              Vcommand_history);
  288.     }
  289.       RETURN_UNGCPRO (apply1 (fun, specs));
  290.     }
  291.  
  292.   /* Here if function specifies a string to control parsing the defaults */
  293.  
  294. #ifdef I18N3
  295.   /* Translate interactive prompt. */
  296.   if (STRINGP (specs))
  297.     {
  298.       Lisp_Object domain = Qnil;
  299.       if (BYTECODEP (fun))
  300.     domain = Fcompiled_function_domain (fun);
  301.       if (NILP (domain))
  302.     specs = Fgettext (specs);
  303.       else
  304.     specs = Fdgettext (domain, specs);
  305.     }
  306.   else if (prompt_data)
  307.     /* We do not have to worry about domains in this case because
  308.        prompt_data is non-nil only for built-in functions, which
  309.        always use the default domain. */
  310.     prompt_data = gettext (prompt_data);
  311. #endif
  312.  
  313.   /* Handle special starting chars `*' and `@' and `_'.  */
  314.   prompt_index = 0;
  315.   {
  316.     struct gcpro gcpro1, gcpro2;
  317.     GCPRO2 (function, specs);
  318.  
  319.     for (;;)
  320.       {
  321.     if (STRINGP (specs)) prompt_data = (CONST char *) string_data (XSTRING (specs));
  322.     
  323.     if (prompt_data[prompt_index] == '*')
  324.       {
  325.         prompt_index++;
  326.         if (!NILP (current_buffer->read_only))
  327.           barf_if_buffer_read_only (current_buffer, -1, -1);
  328.       }
  329.     else if (prompt_data[prompt_index] == '@')
  330.       {
  331.         prompt_index++;
  332.         /* For non-window systems we just silently ignore @. */
  333. #ifdef HAVE_WINDOW_SYSTEM
  334.         if (! NILP (Vcurrent_mouse_event)) 
  335.           {
  336.         Lisp_Object window = Fevent_window (Vcurrent_mouse_event);
  337.         if (!NILP (window))
  338.           Fselect_window (window);
  339.           }
  340. #endif /* HAVE_WINDOW_SYSTEM */
  341.       }
  342.     else if (prompt_data[prompt_index] == '_')
  343.       {
  344.         prompt_index++;
  345.         set_zmacs_region_stays = 1;
  346.       }
  347.     else
  348.       {
  349.         UNGCPRO;
  350.         break;
  351.       }
  352.       }
  353.   }
  354.  
  355.   /* Count the number of arguments the interactive spec would have
  356.      us give to the function.  */
  357.   argcount = 0;
  358.   {
  359.     CONST char *tem;
  360.     for (tem = prompt_data + prompt_index; *tem; )
  361.       {
  362.     /* 'r' specifications ("point and mark as 2 numeric args")
  363.        produce *two* arguments.  */
  364.     if (*tem == 'r')
  365.       argcount += 2;
  366.     else
  367.       argcount += 1;
  368.     tem = (CONST char *) strchr (tem + 1, '\n');
  369.     if (!tem)
  370.       break;
  371.     tem++;
  372.       }
  373.   }
  374.  
  375.   if (argcount == 0)
  376.     {
  377.       /* Interactive function or no arguments; just call it */
  378.       if (EQ (record_flag, Qlambda))
  379.     return (Qnil);
  380.       if (!NILP (record_flag))
  381.     {
  382.       Vcommand_history = Fcons (list1 (function), Vcommand_history);
  383.     }
  384.       specbind (Qcommand_debug_status, Qnil);
  385.       fun = call0 (fun);
  386.       if (set_zmacs_region_stays)
  387.     zmacs_region_stays = 1;
  388.       return (unbind_to (speccount, fun));
  389.     }
  390.  
  391.   /* Read interactive arguments */
  392.   {
  393.     /* args[-1] is the function to call */
  394.     /* args[n] is the n'th argument to the function */
  395.     int alloca_size = (1    /* function to call */
  396.                        + argcount /* actual arguments */
  397.                        + argcount /* visargs */
  398.                        + argcount /* varies */
  399.                        );
  400.     Lisp_Object *args
  401.       = (((Lisp_Object *) alloca (sizeof (Lisp_Object) * alloca_size))
  402.          + 1);
  403.     /* visargs is an array of either Qnil or user-friendlier versions (often
  404.      *  strings) of previous arguments, to use in prompts for succesive
  405.      *  arguments.  ("Often strings" because emacs didn't used to have
  406.      *  format %S and prin1-to-string.) */
  407.     Lisp_Object *visargs = args + argcount;
  408.     /* If varies[i] is non-null, the i'th argument shouldn't just have
  409.        its value in this call quoted in the command history.  It should be
  410.        recorded as a call to the function named varies[i]]. */
  411.     Lisp_Object *varies = visargs + argcount;
  412.     int arg_from_tty = 0;
  413.     REGISTER int argnum;
  414.     struct gcpro gcpro1, gcpro2;
  415.  
  416.     args[-1] = function;
  417.     for (argnum = 0; argnum < alloca_size - 1; argnum++)
  418.       args[argnum] = Qnil;
  419.  
  420.     /* Must GC-protect args[-1] (ie function) because Ffuncall doesn't */
  421.     /* `function' itself isn't GC-protected -- use args[-1] from here
  422.        (actually, doesn't matter since Emacs GC doesn't relocate, sigh) */
  423.     GCPRO2 (prefix, args[-1]);
  424.     gcpro2.nvars = alloca_size;
  425.  
  426.     /* Marginal kludge.  Use an evaluated interactive spec instead of this!
  427.      * if (SYMBOLP (args[-1])
  428.      *     && !NILP (Fget (args[-1], Qenable_recursive_minibuffers, Qnil)))
  429.      *   specbind (Qenable_recursive_minibuffers, Qt);
  430.      */
  431.  
  432.     for (argnum = 0; ; argnum++)
  433.       {
  434.     CONST char *prompt_start = prompt_data + prompt_index + 1;
  435.     CONST char *prompt_limit = (CONST char *) strchr (prompt_start, '\n');
  436.     int prompt_length;
  437.     prompt_length = ((prompt_limit) 
  438.              ? (prompt_limit - prompt_start)
  439.              : strlen (prompt_start));
  440.     if (prompt_limit && prompt_limit[1] == 0)
  441.       {
  442.         prompt_limit = 0;    /* "sfoo:\n" -- strip tailing return */
  443.         prompt_length -= 1;
  444.       }
  445.     /* This uses `visargs' instead of `args' so that global-set-key
  446.        prompts with "Set key C-x C-f to command: "instead of printing
  447.        event objects in there.
  448.      */
  449. #define PROMPT() callint_prompt ((Bufbyte *) prompt_start, prompt_length, visargs, argnum)
  450.     switch (prompt_data[prompt_index])
  451.       {
  452.       case 'a':        /* Symbol defined as a function */
  453.         {
  454.           Lisp_Object tem = call1 (Qread_function, PROMPT ());
  455.           args[argnum] = tem;
  456.           arg_from_tty = 1;
  457.           break;
  458.         }
  459.       case 'b':           /* Name of existing buffer */
  460.         {
  461.           Lisp_Object def = Fcurrent_buffer ();
  462.           if (EQ (Fselected_window (Qnil), minibuf_window))
  463.         def = Fother_buffer (def, Qnil, Qnil);
  464.               /* read-buffer returns a buffer name, not a buffer! */
  465.           args[argnum] = call3 (Qread_buffer, PROMPT (), def,
  466.                     Qt);
  467.           arg_from_tty = 1;
  468.           break;
  469.         }
  470.       case 'B':        /* Name of buffer, possibly nonexistent */
  471.         {
  472.               /* read-buffer returns a buffer name, not a buffer! */
  473.           args[argnum] = call2 (Qread_buffer, PROMPT (),
  474.                     Fother_buffer (Fcurrent_buffer (), Qnil,
  475.                            Qnil));
  476.           arg_from_tty = 1;
  477.           break;
  478.         }
  479.       case 'c':        /* Character */
  480.         {
  481.               Lisp_Object tem;
  482.           int speccount = specpdl_depth ();
  483.  
  484.           specbind (Qcursor_in_echo_area, Qt);
  485.           message ("%s", string_data (XSTRING (PROMPT ())));
  486.           tem = (call0 (Qread_char));
  487.               args[argnum] = tem;
  488.               /* visargs[argnum] = Fsingle_key_description (tem); */
  489.  
  490.           unbind_to (speccount, Qnil);
  491.  
  492.           /* #### `C-x / a' should not leave the prompt in the minibuffer.
  493.          This isn't the right fix, because (message ...) (read-char)
  494.          shouldn't leave the message there either... */
  495.           message (0);
  496.  
  497.           arg_from_tty = 1;
  498.           break;
  499.         }
  500.       case 'C':        /* Command: symbol with interactive function */
  501.         {
  502.           Lisp_Object tem = call1 (Qread_command, PROMPT ());
  503.           args[argnum] = tem;
  504.           arg_from_tty = 1;
  505.           break;
  506.         }
  507.       case 'd':        /* Value of point.  Does not do I/O.  */
  508.         {
  509.           args[argnum] = make_number (BUF_PT (current_buffer));
  510.           varies[argnum] = Qpoint;
  511.           break;
  512.         }
  513.       case 'e':
  514.         {
  515.           args[argnum] = Vcurrent_mouse_event;
  516.           break;
  517.         }
  518.       case 'D':        /* Directory name. */
  519.         {
  520.           args[argnum] = call4 (Qread_directory_name, PROMPT (),
  521.                     Qnil, /* dir */
  522.                     current_buffer->directory, /* default */
  523.                     Qt /* must-match */
  524.                     );
  525.           arg_from_tty = 1;
  526.           break;
  527.         }
  528.       case 'f':        /* Existing file name. */
  529.         {
  530.           Lisp_Object tem = call4 (Qread_file_name, PROMPT (),
  531.                        Qnil, /* dir */
  532.                        Qnil, /* default */
  533.                        make_number (0) /* must-match */
  534.                        );
  535.               args[argnum] = tem;
  536.           arg_from_tty = 1;
  537.           break;
  538.         }
  539.       case 'F':        /* Possibly nonexistent file name. */
  540.         {
  541.           args[argnum] = call4 (Qread_file_name, PROMPT (),
  542.                     Qnil, /* dir */
  543.                     Qnil, /* default */
  544.                     Qnil /* must-match */
  545.                     );
  546.           arg_from_tty = 1;
  547.           break;
  548.         }
  549.       case 'i':        /* Ignore an argument -- Does not do I/O */
  550.         {
  551.           break;
  552.         }
  553.       case 'k':        /* Key sequence (vector of events) */
  554.         {
  555.           Lisp_Object tem = Fread_key_sequence (PROMPT ());
  556.           visargs[argnum] = Fkey_description (tem);
  557.           /* The following makes `describe-key' not work with
  558.          extent-local keymaps and such; and anyway, it's
  559.          contrary to the documentation. */
  560.           /* args[argnum] = call1 (Qevents_to_keys, tem); */
  561.           args[argnum] = tem;
  562.           arg_from_tty = 1;
  563.           break;
  564.         }
  565.  
  566.       case 'm':        /* Value of mark.  Does not do I/O.  */
  567.         {
  568.           args[argnum] = make_number (check_mark ());
  569.           varies[argnum] = Qmark;
  570.           break;
  571.         }
  572.       case 'n':        /* Read number from minibuffer.  */
  573.         {
  574.         read_number:
  575.           args[argnum] = call2 (Qread_number, PROMPT (), Qt);
  576.           /* numbers are too boring to go on command history */
  577.           /* arg_from_tty = 1; */
  578.               break;
  579.             }
  580.       case 'N':        /* Prefix arg, else number from minibuffer */
  581.         {
  582.           if (NILP (prefix))
  583.         goto read_number;
  584.               else
  585.                 goto prefix_value;
  586.         }
  587.       case 'P':        /* Prefix arg in raw form.  Does no I/O.  */
  588.         {
  589.           args[argnum] = prefix;
  590.           break;
  591.         }
  592.       case 'p':        /* Prefix arg converted to number.  No I/O. */
  593.             {
  594.             prefix_value:
  595.               {
  596.                 Lisp_Object tem = Fprefix_numeric_value (prefix);
  597.                 args[argnum] = tem;
  598.               }
  599.               break;
  600.             }
  601.       case 'r':        /* Region, point and mark as 2 args. */
  602.         {
  603.           Bufpos tem = check_mark ();
  604.           args[argnum] = make_number (((BUF_PT (current_buffer) < tem) ? BUF_PT (current_buffer) : tem));
  605.           varies[argnum] = Qregion_beginning;
  606.           args[++argnum] = make_number (((BUF_PT (current_buffer) > tem) ? BUF_PT (current_buffer) : tem));
  607.           varies[argnum] = Qregion_end;
  608.           break;
  609.         }
  610.       case 's':        /* String read via minibuffer.  */
  611.         {
  612.           args[argnum] = call1 (Qread_string, PROMPT ());
  613.           arg_from_tty = 1;
  614.           break;
  615.         }
  616.       case 'S':        /* Any symbol.  */
  617.         {
  618. #if 0                /* Historical crock */
  619.           Lisp_Object tem = intern ("minibuffer-local-ns-map");
  620.           tem = find_symbol_value (tem);
  621.           if (EQ (tem, Qunbound)) tem = Qnil;
  622.           tem = call3 (Qread_from_minibuffer, PROMPT (), Qnil,
  623.                tem);
  624.           args[argnum] = Fintern (tem, Qnil);
  625. #else /* 1 */
  626.           visargs[argnum] = Qnil;
  627.           for (;;)
  628.         {
  629.           Lisp_Object tem = call5 (Qcompleting_read,
  630.                        PROMPT (),
  631.                        Vobarray,
  632.                        Qnil,
  633.                        Qnil,
  634.                        /* nil, or prev attempt */
  635.                        visargs[argnum]);
  636.           visargs[argnum] = tem;
  637.           /* I could use condition-case with this loser, but why bother?
  638.            * tem = Fread (tem); check-symbol-p;
  639.            */
  640.           tem = Fintern (tem, Qnil);
  641.           args[argnum] = tem;
  642.           if (string_length (XSYMBOL (tem)->name) > 0)
  643.             /* Don't accept the empty-named symbol.  If the loser
  644.                really wants this s/he can call completing-read 
  645.                        directly */
  646.             break;
  647.         }
  648. #endif /* 1 */
  649.           arg_from_tty = 1;
  650.           break;
  651.         }
  652.       case 'v':        /* Variable name: user-variable-p symbol */
  653.         {
  654.           Lisp_Object tem = call1 (Qread_variable, PROMPT ());
  655.           args[argnum] = tem;
  656.           arg_from_tty = 1;
  657.           break;
  658.         }
  659.       case 'x':        /* Lisp expression read but not evaluated */
  660.         {
  661.           args[argnum] = call1 (Qread_expression, PROMPT ());
  662.               /* visargs[argnum] = Fprin1_to_string (args[argnum], Qnil); */
  663.           arg_from_tty = 1;
  664.           break;
  665.         }
  666.       case 'X':        /* Lisp expression read and evaluated */
  667.         {
  668.           Lisp_Object tem = call1 (Qread_expression, PROMPT ());
  669.           /* visargs[argnum] = Fprin1_to_string (tem, Qnil); */
  670.           args[argnum] = Feval (tem);
  671.           arg_from_tty = 1;
  672.           break;
  673.         }
  674. #ifdef MULE
  675.       case 'Z':        /* Coding-system symbol or nil if no prefix */
  676.         {
  677.           if (NILP (prefix_arg))
  678.         {
  679.           args[argnum] = Qnil;
  680.           varies[argnum] = -1;
  681.         }
  682.           else 
  683.         {
  684.           args[argnum] =
  685.             call1 (Qread_non_nil_coding_system, PROMPT ());
  686.           arg_from_tty = 1;
  687.         }
  688.           break;
  689.         }
  690.       case 'z':        /* Coding-system symbol */
  691.         {
  692.           args[argnum] = call1 (Qread_coding_system, PROMPT ());
  693.           arg_from_tty = 1;
  694.           break;
  695.         }
  696. #endif
  697.       default:
  698.         {
  699.           error ("Invalid `interactive' control letter \"%c\" (#o%03o).",
  700.              prompt_data[prompt_index],
  701.              prompt_data[prompt_index]);
  702.         }
  703.       }
  704. #undef PROMPT
  705.     if (NILP (visargs[argnum]))
  706.       visargs[argnum] = args[argnum];
  707.  
  708.     if (!prompt_limit)
  709.       break;
  710.     if (STRINGP (specs)) prompt_data = (CONST char *) string_data (XSTRING (specs));
  711.     prompt_index += prompt_length + 1 + 1; /* +1 to skip spec, +1 for \n */
  712.       }
  713.     unbind_to (speccount, Qnil);
  714.  
  715.     QUIT;
  716.  
  717.     if (EQ (record_flag, Qlambda))
  718.       {
  719.     RETURN_UNGCPRO (Flist (argcount, args));
  720.       }
  721.       
  722.     if (arg_from_tty || !NILP (record_flag))
  723.       {
  724.         /* Reuse visargs as a temporary for constructing the command history */
  725.     for (argnum = 0; argnum < argcount; argnum++)
  726.       {
  727.         if (!NILP (varies[argnum]))
  728.           visargs[argnum] = list1 (varies[argnum]);
  729.         else
  730.           visargs[argnum] = quotify_arg (args[argnum]);
  731.       }
  732.     Vcommand_history = Fcons (Fcons (args[-1], Flist (argcount, visargs)),
  733.                   Vcommand_history);
  734.       }
  735.  
  736.     specbind (Qcommand_debug_status, Qnil);
  737.     fun = Ffuncall (argcount + 1, args - 1);
  738.     UNGCPRO;
  739.     if (set_zmacs_region_stays)
  740.       zmacs_region_stays = 1;
  741.     return (unbind_to (speccount, fun));
  742.   }
  743. }
  744.  
  745. DEFUN ("prefix-numeric-value", Fprefix_numeric_value, Sprefix_numeric_value,
  746.   1, 1, 0,
  747.   "Return numeric meaning of raw prefix argument ARG.\n\
  748. A raw prefix argument is what you get from `(interactive \"P\")'.\n\
  749. Its numeric meaning is what you would get from `(interactive \"p\")'.")
  750.   (raw)
  751.      Lisp_Object raw;
  752. {
  753.   int val;
  754.  
  755.   if (NILP (raw))
  756.     val = 1;
  757.   else if (EQ (raw, Qminus))
  758.     val = -1;
  759.   else if (INTP (raw))
  760.     val = XINT (raw);
  761.   else if (CONSP (raw) && INTP (XCAR (raw)))
  762.     val = XINT (XCAR (raw));
  763.   else
  764.     val = 1;
  765.  
  766.   return (make_number (val));
  767.  
  768. }
  769.  
  770. void
  771. syms_of_callint (void)
  772. {
  773.   defsymbol (&Qcall_interactively, "call-interactively");
  774.   defsymbol (&Qread_from_minibuffer, "read-from-minibuffer");
  775.   defsymbol (&Qcompleting_read, "completing-read");
  776.   defsymbol (&Qread_file_name, "read-file-name");
  777.   defsymbol (&Qread_directory_name, "read-directory-name");
  778.   defsymbol (&Qread_string, "read-string");
  779.   defsymbol (&Qread_buffer, "read-buffer");
  780.   defsymbol (&Qread_variable, "read-variable");
  781.   defsymbol (&Qread_function, "read-function");
  782.   defsymbol (&Qread_command, "read-command");
  783.   defsymbol (&Qread_number, "read-number");
  784.   defsymbol (&Qread_expression, "read-expression");
  785. #ifdef MULE
  786.   defsymbol (&Qread_coding_system, "read-coding-system");
  787.   defsymbol (&Qread_non_nil_coding_system, "read-non-nil-coding-system");
  788. #endif
  789.   defsymbol (&Qevents_to_keys, "events-to-keys");
  790.   defsymbol (&Qcommand_debug_status, "command-debug-status");
  791.   defsymbol (&Qenable_recursive_minibuffers, "enable-recursive-minibuffers");
  792.   defsymbol (&Qcommand_debug_status, "command-debug-status");
  793.   defsymbol (&Quser_variable_p, "user-variable-p");
  794.   defsymbol (&Qcurrent_prefix_arg, "current-prefix-arg");
  795.  
  796.   defsubr (&Sinteractive);
  797.   defsubr (&Scall_interactively);
  798.   defsubr (&Sprefix_numeric_value);
  799. }
  800.  
  801. void
  802. vars_of_callint (void)
  803. {
  804.   DEFVAR_LISP ("prefix-arg", &Vprefix_arg,
  805.     "The value of the prefix argument for the next editing command.\n\
  806. It may be a number, or the symbol `-' for just a minus sign as arg,\n\
  807. or a list whose car is a number for just one or more C-U's\n\
  808. or nil if no argument has been specified.\n\
  809. \n\
  810. You cannot examine this variable to find the argument for this command\n\
  811. since it has been set to nil by the time you can look.\n\
  812. Instead, you should use the variable `current-prefix-arg', although\n\
  813. normally commands can get this prefix argument with (interactive \"P\").");
  814.   Vprefix_arg = Qnil;
  815.  
  816.   DEFVAR_LISP ("current-prefix-arg", &Vcurrent_prefix_arg,
  817.     "The value of the prefix argument for this editing command.\n\
  818. It may be a number, or the symbol `-' for just a minus sign as arg,\n\
  819. or a list whose car is a number for just one or more C-U's\n\
  820. or nil if no argument has been specified.\n\
  821. This is what `(interactive \"P\")' returns.");
  822.   Vcurrent_prefix_arg = Qnil;
  823.  
  824.   DEFVAR_LISP ("current-mouse-event", &Vcurrent_mouse_event,
  825.     "The mouse-button event which invoked this command, or nil.\n\
  826. This is what `(interactive \"e\")' returns.");
  827.   Vcurrent_mouse_event = Qnil;
  828.  
  829.   DEFVAR_LISP ("command-history", &Vcommand_history,
  830.     "List of recent commands that read arguments from terminal.\n\
  831. Each command is represented as a form to evaluate.");
  832.   Vcommand_history = Qnil;
  833.  
  834.   DEFVAR_LISP ("command-debug-status", &Vcommand_debug_status,
  835.     "Debugging status of current interactive command.\n\
  836. Bound each time `call-interactively' is called;\n\
  837. may be set by the debugger as a reminder for itself.");
  838.   Vcommand_debug_status = Qnil;
  839. }
  840.